Attribute VB_Name = "modODBCMedtronic"
'---------------------------------------------------------------------------------------
'Module     : modODBC
'Date       : 05/18/2004
'Updated    : 02/21/2005
'Author     : Chris Elwell
'Purpose    : This is an example of a CIC integration module. This is for demostration
'           purposes only. You must write the code required to get/writeback data from/to
'           your customer's data source.
'
'           This example uses the FSMSClientTest.mdb. A DSN is setup as FSMSClientTest.
'           Regardless of the integration method, CICs must have a module that contains
'           specific sub routines. All of these subs/functions listed below must exist
'           as they are called from the main program.
'           Public Function GetData(ByVal strKey As String) As Boolean - this routine is
'               called when the Order ID field loses focus. This is where you would code to
'               get order data from a customer and populate the screen fields. You can create
'               and call as many support routines as necessary. Also, this routine should
'               return a boolean True if getting the order data was succesful and a boolean
'               False if it was not.
'           Public Sub WriteReply() - this is called after a successful shipment. A typical
'               use would be to write FXRS reply data back to a customer's system, but can be
'               used for anything that you want to have happen after a pckage is shipped.
'           Public Sub WriteError() - this is called after an error is returned from FXRS.
'           Public Sub WriteDelete(ByVal strTracking As String) - this is called after a
'               package is successfully deleted.
'           Public Sub AfterClose() - this is called after FXRS is closed.
'           Public Sub BeforeClose() - this is called just before an FXRS close transaction
'               is sent.
'Updated:   Public Function BeforeShip() - Return TRUE to continue shipment, False to cancel.
'           Public Sub Initialize() - this is called once on program execution.
'           Public Sub BeforeBatch() - this is called before processing a batch file.
'           Public Sub BeforeBatchShip() - this is called before each individual batch transaction.
'New:       Public Sub AfterAddrLookup() - this is called after cboCustID, cboContact, and cboCompany lose focus
'New:       Public Sub AfterDeptLostFocus() - this is called after cboDept or f38 loses focus.
'
' 2005-04-20, JFW, Added AddDSN for integration database.
' 2006-11-07, JFW, Add order to MPS select to preserve package order
' 2007-04-13, JFW, Allow for custom screen display, AfterConnect
' 2007-05-23, JFW, CTI intetration for Mike.
'
'---------------------------------------------------------------------------------------


Option Explicit

#If Medtronic Then

Dim m_CNInDB As ADODB.Connection
Dim m_CNInText As ADODB.Connection
Dim m_CNOut As ADODB.Connection
Dim m_RS As ADODB.Recordset
Dim m_strLine As String


'2/8/05 - API function declaration to add DSN to system used in AddDSN() function.
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal _
   hwndParent As Long, ByVal fRequest As Long, ByVal _
   lpszDriver As String, ByVal lpszAttributes As String) As Long

'+
' 2006-09-20, JFW, From Copernicus FXI
' Declare object(s)
Public g_strCustNo As String        'Hold Customer Number
Public g_strPONo As String          'Hold Customer PO Number
Public g_strRefNo As String         'Hold Customer Reference Number
Public g_strCountry As String       'Hold shipto Country
Public g_strZip As String           'Holds zip code
Public g_strEmail As String         'Hold Email address
Public g_strEmail2 As String        'Hold Email address
Public g_blnServiceOrder As Boolean 'Flage for email
'~


'    mstrIMPORT_FILE_PATH = g_clsSettings.Setting("IntegrationFolder")
'    If mstrIMPORT_FILE_PATH = "" Then
'        If GetSystemName = "CAN00283812" Then
'            g_clsSettings.Setting("IntegrationFolder") = "C:\Documents and Settings\271425\My Documents\CUSTOMERDATA\CUSTOMERDATA\ElectroSonic\"
'        ElseIf GetSystemName = "WINXPC9CA96EA3" Then
'            g_clsSettings.Setting("IntegrationFolder") = "C:\Documents and Settings\563774\My Documents\FXI\Projects\Meena\ELECTROSONIC\"
'        Else
'            g_clsSettings.Setting("IntegrationFolder") = "Z:\OUTBOUND\"
'        End If
'        g_clsSettings.SaveSettings
'        mstrIMPORT_FILE_PATH = g_clsSettings.Setting("IntegrationFolder")
'        frmMsgBox.ShowMessage "Configuration file (FSMSClient.xml) updated with IntegrationFolder.", 8000
'    End If



' 2011-07-10, JFW, New interface to clear DG disclaimer automatically.
Public Function AfterDGDisclaimer() As Boolean
    AfterDGDisclaimer = False
End Function
'

Private Function EXPORT_FILE_PATH() As String
    If GetSystemName = "WINXPC9CA96EA3" Then
        EXPORT_FILE_PATH = "C:\Documents and Settings\563774\My Documents\FXI\Projects\Medtronic\Database\FedExMANIFEST.CSV"
    ElseIf True Then
        EXPORT_FILE_PATH = "N:\Database\FedExMANIFEST.CSV"
    Else
        EXPORT_FILE_PATH = "F:\FedExMANIFEST.CSV"
    End If
End Function

Private Function ImportFilePath() As String
    If GetSystemName = "WINXPC9CA96EA3" Then
        ImportFilePath = "C:\Documents and Settings\563774\My Documents\FXI\Projects\Medtronic\Database\Import\"
    ElseIf True Then
        ImportFilePath = "N:\Database\Import\"
    Else
        ImportFilePath = "F:\Import\"
    End If
End Function




'---------------------------------------------------------------------------------------
' Procedure : AddDSN
' DateTime  : 2/8/2005
' Purpose   : Adds the FSMSClient v720.3 DSN
' Call from : Form_Load
'---------------------------------------------------------------------------------------
'
Private Function AddDSN() As Boolean
    On Error GoTo EH

    Dim ret As Long
    Dim Driver As String
    Dim Attributes As String

    If GetSystemName = "WINXPC9CA96EA3" Then
        Driver = "Microsoft Access Driver (*.mdb)"
        Attributes = Attributes & "DBQ=C:\Documents and Settings\563774\My Documents\FXI\Projects\Linda\AllSeating.mdb" & Chr(0)
        Attributes = Attributes & "DSN=FedExAllSeating" & Chr(0)
        Attributes = Attributes & "DESCRIPTION=FSMS Client All Seating ship data" & Chr(0)

        ret = SQLConfigDataSource(0, 4, Driver, Attributes)
        If ret <> 1 Then
            AddDSN = False
        Else
            AddDSN = True
        End If

    Else
        ' 2007-05-23, JFW, no autodefine, DSN=FEDEX;UID=sa;PWD=sa
        AddDSN = True
    End If

    Exit Function
EH:
    AddDSN = False

End Function
'

Public Function ClearCommodity() As Boolean

End Function
'

Public Function ClearShipScreen() As Boolean

End Function


'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetData(ByVal strKeyValue As String) As Boolean
    On Local Error GoTo Handler
    Dim strSelect As String
    Dim strUserPwd As String    'DSN user and password separated by ','
    Dim strUser As String       'DSN user name
    Dim strPwd As String        'DSN user password
    Dim strData As String
    Dim i As Long
    Dim boolFirstTry As Boolean

    ' Declare variables for procedure
    Dim importCollect As Collection
    Dim objRecordset As ADODB.Recordset
    Dim strSQL As String

'    If g_clsReg.GetRegistryValue("IntegrationLevel", "Writeback") <> "Writeback" _
'    And g_clsReg.GetRegistryValue("IntegrationLevel", "Writeback") <> "Order Lookup" Then
'        GetData = True
'        Exit Function
'    End If

    If Not Connect Then Exit Function   'set conection and recordset

TryHere:
    Set importCollect = New Collection

    strSQL = "Select * From `Order`"
    strSQL = strSQL & " Where `Lookup` = '" & strKeyValue & "'"
    Set objRecordset = New ADODB.Recordset
    objRecordset.Open strSQL, m_CNInDB
    If Not objRecordset.BOF Then
        importCollect.Add objRecordset
    Else
        If Not boolFirstTry Then
            boolFirstTry = True
            Call RecordImport
            GoTo TryHere
        Else
            GoTo Release
        End If
    End If

    strSQL = "Select * From `Item`"
    strSQL = strSQL & " Where `Lookup` = '" & strKeyValue & "'"
    Set objRecordset = New ADODB.Recordset
    objRecordset.Open strSQL, m_CNInDB
    importCollect.Add objRecordset

    strSQL = "Select * From `Package`"
    strSQL = strSQL & " Where `Lookup` = '" & strKeyValue & "'"
    Set objRecordset = New ADODB.Recordset
    objRecordset.Open strSQL, m_CNInDB
    importCollect.Add objRecordset

    Call DeleteIntlCommodities(strKeyValue)

    Call GetDataToShip(importCollect)

    frmShip.f1670.SetFocus
    
    GetData = True

Release:
    On Error Resume Next
    Set objRecordset = Nothing
    Exit Function
Handler:
    MsgBox Err.Description, , "modODBC.GetData"
    Call Kill
    Resume Release
    Resume

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Sub GetDataToShip(objRecords As Collection)

    On Local Error GoTo Handler

    Dim strZipCode As String
    Dim intZipLen As Integer
    Dim lngWeight As Double
    Dim strHarmCode As String
    Dim strMyHarmCode As String
    Dim strCCofMan  As String
    Dim strTaxID As String
    Dim i As Long, j As Long
    Dim strAddressLine As String
    Dim strPhone As String
    Dim rsZip As New ADODB.Recordset
    Dim strProv As String

'    ' Declare variables for procedure
'    Dim i As Long
'    Dim blnADDComm As Boolean
'    Dim strCommCode As String
'    Dim strSQLComm As String
'    Dim strMeter As String

    Dim rsOrder As ADODB.Recordset
    Dim rsCommodity As ADODB.Recordset
    Dim rsPackage As ADODB.Recordset
    Dim strCountry As String            'Country
    Dim strZip As String                'Zip Code

    Set rsOrder = objRecords.item(1)
    Set rsCommodity = objRecords.item(2)
    Set rsPackage = objRecords.item(3)

    'PHONE
    strPhone = Trim(CStr(rsOrder.Fields("ST_PHONE").Value & ""))
    strPhone = Digit(strPhone)
    strPhone = PhoneTrim(strPhone)
    If Len(strPhone) <> 10 Then
        strPhone = ""
    End If
    
    'Load shipper phone number if field import is blank
    If strPhone = "" Then
        strPhone = g_str183
    End If

    'COUNTRY
    strCountry = CStr(rsOrder.Fields("ST_COUNTRY").Value & "")
    frmShip.f50.Text = strCountry
    DoEvents

    'ZIP
    strZip = CStr(rsOrder.Fields("ST_POSTAL").Value & "")

        'Load 5 digit zip for US
    If strCountry = "US" Then
        Select Case Len(strZip)
        Case 4
            strZip = "0" & strZip
        Case 3
            strZip = "00" & strZip
        Case 2
            strZip = "000" & strZip
        Case 1
            strZip = "0000" & strZip
        Case Else
            strZip = strZip
        End Select
    End If

    With frmShip
        .f1670 = ""
        If IsNumeric(rsOrder.Fields("TOT_WGT").Value) Then
            If CDbl(rsOrder.Fields("TOT_WGT").Value) > 0 Then
                .f1670 = rsOrder.Fields("TOT_WGT").Value
            End If
        End If
        If frmSetup.chkScaleConnected = 1 Then
            .f1670 = ReadScale(Right(frmSetup.cmbScalePort, 1), Left(frmSetup.cboProtocol, 1))
        End If

        .f75.Text = "LBS"
        .f1274.Text = "01"
        .f1273.Text = "01"
        .f23.Text = 1

'        If IsNumeric(rsOrder.Fields("DECL_VALUE").Value) Then
'            If CDbl(rsOrder.Fields("DECL_VALUE").Value) > 0 Then
'                .SpecialServices.DeclaredValue = CDbl(rsOrder.Fields("DECL_VALUE").Value)
'            End If
'        End If

        .f3056.Text = rsOrder.Fields("REFERENCE1").Value _
            & IIf(rsOrder.Fields("REFERENCE1").Value <> "" _
                    And rsOrder.Fields("REFERENCE2").Value <> "", "-", "") _
            & rsOrder.Fields("REFERENCE2").Value
        
        ' Intl
        'debugprint "1090 " & .f1090.Text
        If strCountry = "CA" Then
            .f1090.Text = "CAD"
        Else
            If rsOrder.Fields("CURR_TYPE").Value & "" <> "CDN" Then
                .f1090.Text = "CAD"
            ElseIf rsOrder.Fields("CURR_TYPE").Value & "" <> "" Then
                .f1090.Text = rsOrder.Fields("CURR_TYPE").Value & ""
            End If
        End If
        'debugprint "1090 " & .f1090.Text
        
        ' .UltimateDestination = strCountry
        If strCountry <> "CA" Then
            '.f113 = False
            .f70.Text = 3
            If IsNumeric(rsOrder.Fields("TERMS_SALE").Value) Then
                .f70.Text = rsOrder.Fields("TERMS_SALE").Value
            Else
                .f70.Text = 1
            End If
            '.IsDocShipment = False
            '.PartiesRelated = False
'            If rsOrder.Fields("INVOICE_LINES").Value > 0 Then
'                call InsertIntlCommodities(strkeyvalue,0,rsOrder.Fields("Description").Value
'
'                With .Commodities.Add("1")
'                    .PartNumber = rsOrder.Fields("PART NUMBER").Value
'                    .UnitQuantity = rsOrder.Fields("NUMBER_OF_UNITS").Value
'                    .UnitOfMeasure = rsOrder.Fields("UNIT_OF_MEASURE").Value
'                    .Description = rsOrder.Fields("Description").Value
'                    .HarmonizedCode = rsOrder.Fields("HARMONIZED_CODE").Value
'                    .CountryOfMfg = rsOrder.Fields("COUNTRY_ORIGIN").Value
'                    .UnitValue = rsOrder.Fields("UNIT_VALUE").Value
'                End With
'            End If
'
'            If rsCommodity.RecordCount > 0 Then
'            For i = 0 To rsCommodity.RecordCount - 1
'                With .Commodities.Add(CStr(i + 2))
'                    .PartNumber = rsCommodity.Records(i).Fields("PART NUMBER").Value
'                    .UnitQuantity = rsCommodity.Records(i).Fields("NUMBER_OF_UNITS").Value
'                    .UnitOfMeasure = rsCommodity.Records(i).Fields("UNIT_OF_MEASURE").Value
'                    .Description = rsCommodity.Records(i).Fields("Description").Value
'                    .HarmonizedCode = rsCommodity.Records(i).Fields("HARMONIZED_CODE").Value
'                    .CountryOfMfg = rsCommodity.Records(i).Fields("COUNTRY_ORIGIN").Value
'                    .UnitValue = rsCommodity.Records(i).Fields("UNIT_VALUE").Value
'                End With
'            Next i
'            End If

        End If

        .f25.Text = CStr(rsOrder.Fields("Lookup").Value & "")

        .f13.Text = CStr(rsOrder.Fields("ST_ADDR1").Value & "")
        .f14.Text = CStr(rsOrder.Fields("ST_ADDR2").Value & "")
        If .f13.Text = "" Then
            .f13.Text = .f14.Text
            .f14.Text = ""
        End If


        .f15.Text = CStr(rsOrder.Fields("ST_CITY").Value & "")
        .f11.Text = CStr(rsOrder.Fields("ST_NAME").Value & "")
        .f12.Text = CStr(rsOrder.Fields("ST_CONTACT").Value & "")
        .f18.Text = strPhone
        If strCountry = "CA" Then
            .f16.Text = ZipToProvince(strZip)
        Else
            strProv = CStr(rsOrder.Fields("ST_PROV").Value & "")
            strProv = Replace(strProv, ".", "")
            strProv = Replace(strProv, " ", "")
            strProv = Left(strProv, 2)
            .f16.Text = strProv
        End If
        .f17.Text = strZip

'        If rsPackage.RecordCount > 0 Then '  Not objRecordset.BOF
'            objPackage.Count = rsPackage.RecordCount + 1
'            For i = 0 To rsPackage.RecordCount - 1
'                If IsNumeric(rsPackage.Records(i).Fields("TOT_WGT").Value) Then
'                    .Weight = .Weight + rsPackage.Records(i).Fields("TOT_WGT").Value
'                End If
'            Next i
'        End If

    End With


    g_strErrorLocation = "Done"
Release:
    ' call kill
    Exit Sub
Handler:
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.GetDataToShip"
    Call Kill
    Resume Release
    Resume

End Sub
'



'---------------------------------------------------------------------------------------
' Procedure : RecordExport
' DateTime  : 10/23/2008
' Purpose   : Set export data
'---------------------------------------------------------------------------------------
'
Private Sub RecordExport()

    On Error GoTo RecordExport_Error

    ' Declare variables for procedure
    Dim strRecord As String
    Dim objfile As New FileSystemObject
    ' Declare variables for sql statement
    Dim strCustomerRatesCustomerRatesGrossCharge As String
    Dim strCustomerRatesCustomerRatesSurchargesFuel As String
    Dim strCustomerRatesCustomerRatesSurchargesDeclaredValue As String
    Dim strCustomerRatesCustomerRatesSurchargesODA As String
    Dim strCustomerRatesCustomerRatesSurchargesDeliveryArea As String
    Dim strCustomerRatesCustomerRatesTotalDiscount As String
    Dim strDimensionDimensionsHeight As String
    Dim strDimensionDimensionsLength As String
    Dim strCustomerRatesCustomerRatesNetCharge As String
    Dim strTrackingNumberTrackNo As String
    Dim strMiscellaneousServiceType As String
    Dim strMiscellaneousWeightType As String
    Dim strMiscellaneousWeight As String
    Dim strDimensionDimensionsWidth As String
    Dim strRef As String
    Dim strCompany As String
    Dim strContact As String
    Dim strAddr1 As String
    Dim strCity As String
    Dim strProv As String
    Dim strPostal As String
    Dim strPhone As String
    Dim strDept As String
    Dim strBilledWght As String
    Dim strGST As String
    Dim strPST As String
    Dim strDate As String

    ' Add Title for new file
    If objfile.FileExists(EXPORT_FILE_PATH) = False Then

        strRecord = "TYPE,SHIP_CODE,CUST_CODE,ATTN,NAME,DEPT,STREET,CITY,PROV,POST,TEL,REFERENCE,COST_CENTRE,VALUE,PAYMENT,SERVICE,9_AM,10_30,WEEKEND,DANGER,HOLD,DUTY,EXPCHQ,RETURN,PIECES,TOTAL_WEIGHT,TOTAL_COST,GST,PST,DATE,MANIFEST,LINE_NO,SERVICE_TYPE,UNICODE,TRANSIT,PIN,WEIGHT,LENGTH,WIDTH,HEIGHT,UNIT,PIECE_COST,EXPCHQ_PIN,EXPCHQ_AMOUNT,EXPCHQ_TYPE,EXPCHQ_ATTN,EXPCHQ_NAME,EXPCHQ_DEPT,EXPCHQ_STREET,EXPCHQ_CITY,EXPCHQ_PROV,EXPCHQ_POST,COST_BASE,COST_BEYOND,COST_RURAL,COST_FUEL,COST_DUTY,COST_SP_SERVICE,COST_SP_HAND,COST_DANGER,COST_BROKRAGE,COST_INSURANCE"

        ' Append record to file
        Open EXPORT_FILE_PATH For Append Access Write Shared As #3

        Print #3, strRecord

        strRecord = ""

        Close #3

    End If

    ' Append record to file
    Open EXPORT_FILE_PATH For Append Access Write Shared As #2


    strDate = Format(Date, "MM/DD/YYYY")


            If IsNumeric(g_str34(0)) Then
                strCustomerRatesCustomerRatesGrossCharge = CDbl(g_str34(0))
            Else
                strCustomerRatesCustomerRatesGrossCharge = 0
            End If
            strCustomerRatesCustomerRatesSurchargesFuel = 0 ' ToDo 1393
            If IsNumeric(g_str421) Then
                strCustomerRatesCustomerRatesSurchargesDeclaredValue = CDbl(g_str421)
            Else
                strCustomerRatesCustomerRatesSurchargesDeclaredValue = 0
            End If
            strCustomerRatesCustomerRatesSurchargesODA = 0 ' ODA 423
            strCustomerRatesCustomerRatesSurchargesDeliveryArea = 0 ' ODA 554
            If IsNumeric(g_str36(0)) Then
                strCustomerRatesCustomerRatesTotalDiscount = CDbl(g_str36(0))
            Else
                strCustomerRatesCustomerRatesTotalDiscount = 0
            End If
            If IsNumeric(g_str57) Then
                strDimensionDimensionsHeight = CLng(g_str57)
            Else
                strDimensionDimensionsHeight = 0
            End If
            If IsNumeric(g_str59) Then
                strDimensionDimensionsLength = CLng(g_str59)
            Else
                strDimensionDimensionsLength = 0
            End If
            If IsNumeric(g_str37) Then
                strCustomerRatesCustomerRatesNetCharge = CDbl(g_str37)
            Else
                strCustomerRatesCustomerRatesNetCharge = 0
            End If
            strTrackingNumberTrackNo = g_str29
            strMiscellaneousServiceType = g_str1274
            strMiscellaneousWeightType = g_str75
            If IsNumeric(g_str1670) Then
                strMiscellaneousWeight = CDec(g_str1670) / 100
            Else
                strMiscellaneousWeight = 0
            End If
            If IsNumeric(g_str58) Then
                strDimensionDimensionsWidth = CLng(g_str58)
            Else
                strDimensionDimensionsWidth = 0
            End If
            strRef = g_str25
            strCompany = g_str11
            strContact = g_str12
            strAddr1 = g_str13
            strCity = g_str15
            strProv = g_str16
            strPostal = g_str17
            strPhone = g_str18
            ' strDept = g_str2006
            strBilledWght = g_str60
            'strGST = CDbl(g_str189)
            'strPST = CDbl(g_str191)



        ' If file is not there then add titles

       ' Set position of values, use left to truncate values exceeding the field length
       strRecord = strRecord & Chr(34) & "S" & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strRef & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strCompany & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strContact & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strAddr1 & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strCity & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strProv & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strPostal & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strPhone & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strDept & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strRef & Chr(34) & ","
       strRecord = strRecord & Chr(34) & "FEDEX" & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strMiscellaneousServiceType & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & "1" & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strBilledWght & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strCustomerRatesCustomerRatesNetCharge & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strGST & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strPST & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strDate & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strTrackingNumberTrackNo & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strMiscellaneousWeight & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strDimensionDimensionsLength & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strDimensionDimensionsWidth & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strDimensionDimensionsHeight & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strMiscellaneousWeightType & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strCustomerRatesCustomerRatesNetCharge & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strCustomerRatesCustomerRatesGrossCharge & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strCustomerRatesCustomerRatesSurchargesODA & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strCustomerRatesCustomerRatesSurchargesFuel & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strCustomerRatesCustomerRatesSurchargesDeliveryArea & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & Chr(34) & ","
       strRecord = strRecord & Chr(34) & strCustomerRatesCustomerRatesSurchargesDeclaredValue & Chr(34)

       Print #2, strRecord

        strRecord = ""



Release:
    Close #2

    Exit Sub

RecordExport_Error:

    MsgBox Err.Description & " (RecordExport)", vbSystemModal

End Sub






Public Function RecordImport() As Boolean

    On Error GoTo EH

    Dim i As Long
    Dim rsImport As ADODB.Recordset
    Dim strInsert As String, strData As String, strFields As String
    Dim strLookup As String
    Dim objfile As Scripting.File
    Dim objFolder As Scripting.Folder
    Dim objFS As Scripting.FileSystemObject

    Dim strRecords() As String

    frmMsgBox.ShowMessage "Looking for new orders.", 1000

    Set objFS = CreateObject("Scripting.FileSystemObject")

    Set objFolder = objFS.GetFolder(ImportFilePath)

    For Each objfile In objFolder.Files

            If Not Connect Then Exit Function 'Runs connect function

            If LCase(Right(objfile.Path, 4)) = ".txt" Then

                ' Alpha
                ' string array from f ile reader
                strRecords = RecordImportText(objfile.Path)

                ' for each strRecord
                For i = 0 To UBound(strRecords)

                    ' Select Case Trim(rsImport.Records(i).Fields("RECORD TYPE").Value)
                    Select Case "H"
                    Case "H"
                        strLookup = ""

                        strLookup = Trim(AposTrim(Mid(strRecords(i), 1, 25)))

                        strInsert = "insert into `Order` ("
                        strInsert = strInsert & "[Record Type], Version, Lookup, ST_CUSTID, ST_NAME, ST_CONTACT, ST_PHONE, ST_ADDR1, ST_ADDR2, ST_ADDR3, ST_COUNTRY, ST_CITY, ST_POSTAL, ST_PROV, SRV_LVL, PKG_TYPE, PKG_COUNT, TOT_WGT"
                        strInsert = strInsert & ") values ("

'TOT_DIM Length  Width   Height  "
'BT_OPTION   BT_CUSTID   BT_NAME BT_CONTACT  BTACCT  BT_PHONE    BT_ADDR1    BT_ADDR2    BT_ADDR3    BT_COUNTRY  BT_POSTAL   BT_CITY BT_PROV BT_ACCTNO   DECL_VALUE  SAT_DELV    COD_AMOUNT  X_COD_AMT   COMM_ENTS   ADULT_SIG   DOCUMENTS   INVOICE_NO  CST_BROKER  ST/SO TAXID SO_CUSTID   SO_NAME SO_CONTACT  SO_PHONE    SO_ADDR1    SO_ADDR2    SO_ADDR3    SO_COUNTRY  SO_CITY SO_POSTAL   SO_PROV CUSTOMS_D   INV_COMM    CURR_TYPE   TERMS_SALE  ADD_DOC INVOICE_LINES   PART NUMBER NUMBER_OF_UNITS UNIT_OF_MEASURE DESCRIPTION DESCRIPTION_LINE_2  DESCRIPTION_LINE_3  HARMONIZED_CODE COUNTRY_ORIGIN  UNIT_VALUE  INV_TOTAL   REFERENCE1  REFERENCE2  PKG_REF 1   PKG_REF 2   PKG_REF 3   PKG_REF 4   SHIPPER_ID  SH_ACCTNO   SH_NAME SH_CONTACT  SH_PHONE    SH_FAX  SH_ADDR1    SH_ADDR2    SH_ADDR3    SH_COUNTRY  SH_
'CITY    SH_POSTAL   SH_PROV EMAILASN    EMAILTEXT   VRBL_CONF   CSE CC  USDirect    Return Service  Future Date Auto-Return Decl Statement  Cash Only   Add Handling    Sold to UPS acc Sold to Tax No  GCC Consol Type GCC Port    LID Del Confirm
'H   0   82273247        Medtronic of Canada Ltd.    305-601 West Broadway   9058165211  305-601 West Broadway           CA  Vancouver   V5Z4C2  B.C.    0   1                                                                                                                                                                                                                                   0                                                                                                                                                                           strInsert = Chr(39) & "H" & Chr(39) & ", "

                        strInsert = strInsert & "'H', 0, "
                        strInsert = strInsert & Chr(39) & AposTrim(Mid(strRecords(i), 1, 25)) & Chr(39) & ", "
                        strInsert = strInsert & Chr(39) & AposTrim(Mid(strRecords(i), 1, 25)) & Chr(39) & ", "
                        strInsert = strInsert & Chr(39) & AposTrim(Mid(strRecords(i), 26, 25)) & Chr(39) & ", "
                        strInsert = strInsert & Chr(39) & AposTrim(Mid(strRecords(i), 51, 25)) & Chr(39) & ", "
                        strInsert = strInsert & Chr(39) & AposTrim(Mid(strRecords(i), 156, 25)) & Chr(39) & ", "        ' Phone
                        strInsert = strInsert & Chr(39) & AposTrim(Mid(strRecords(i), 76, 25)) & Chr(39) & ", "      ' Address 1
                        
                        ' 2009-04-06, JFW, New discovery at end of file.
                        ' strInsert = strInsert & Chr(39) & "" & Chr(39) & ", "                                                       ' Address 2
                        strInsert = strInsert & Chr(39) & AposTrim(Mid(strRecords(i), 156, 30)) & Chr(39) & ", "        ' Address 2
                        
                        strInsert = strInsert & Chr(39) & "" & Chr(39) & ", "
                        strInsert = strInsert & Chr(39) & "CA" & Chr(39) & ", "
                        strInsert = strInsert & Chr(39) & AposTrim(Mid(strRecords(i), 101, 20)) & Chr(39) & ", "     ' City
                        strInsert = strInsert & Chr(39) & AposTrim(Mid(strRecords(i), 125, 6)) & Chr(39) & ", "      ' Zip
                        strInsert = strInsert & Chr(39) & AposTrim(Mid(strRecords(i), 121, 4)) & Chr(39) & ", "      ' State
                        strInsert = strInsert & Chr(39) & "01" & Chr(39) & ", "
                        strInsert = strInsert & Chr(39) & "01" & Chr(39) & ", "
                        strInsert = strInsert & Chr(39) & "1" & Chr(39) & ", "
                        strInsert = strInsert & Chr(39) & "1" & Chr(39)  ' & ", "
                        strInsert = strInsert & ")"

                        m_CNInDB.Execute ("delete from `Order` " _
                            & "where Lookup = '" _
                            & Trim(strLookup) & "'")

                        m_CNInDB.Execute ("delete from `Item` " _
                            & "where Lookup = '" _
                            & Trim(strLookup) & "'")

                        m_CNInDB.Execute ("delete from `Package` " _
                            & "where Lookup = '" _
                            & Trim(strLookup) & "'")

                        m_CNInDB.Execute strInsert


                        ' Use only if you want to back up imported files
                        ' FileCopy objFile.Path, BDFilePath & "Uploaded\" & objFile.Name

                    End Select


                Next i

                    objfile.Delete True


            End If



    Next objfile

    Exit Function

EH:
    MsgBox Err.number & "-" & Err.Description, vbCritical Or vbSystemModal _
        , "ODBC1.ImportOrder"
    If False Then
        Resume
    End If

End Function



'---------------------------------------------------------------------------------------
' Procedure : RecordImportText
' DateTime  : 10/8/2008
' Purpose   : Get import data from Fixed File
'---------------------------------------------------------------------------------------
'
Private Function RecordImportText(IMPORT_FILE_PATH As String)

    On Error GoTo RecordImportText_Error

    ' Declare variables for procedure
    Dim strRecords() As String
    Dim strLine As String
    Dim a As Long

    ' Open file
    Open IMPORT_FILE_PATH For Input Access Read Shared As #1

    Do Until EOF(1)
        ' Retrieve record from file
        Line Input #1, strLine
        If Trim(strLine) <> Empty Then

            ' Resize array to append record
            ReDim Preserve strRecords(a) As String
            'Write record to array element
            strRecords(a) = strLine
            ' Increment array count
            a = a + 1

        End If
    Loop

    RecordImportText = strRecords

Release:
    Close #1
    Erase strRecords

    Exit Function

RecordImportText_Error:

    MsgBox Err.Description & " (RecordImportText)", vbSystemModal

    Resume Release

End Function




'---------------------------------------------------------------------------------------
' Procedure : WriteReply()
' DateTime  : 2/14/2005
' Purpose   : REQUIRED SUB. Called after a successful ship transaction.
'             This example shows how to obtain multiple occurrence fields from the
'             FXRS reply and how to obtain multiple occurrence fields included in the
'             input transaction but not returned in the FXRS reply.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReply()

    On Local Error GoTo Handler

    Call RecordExport

    Dim strSelect As String
    Dim strQuery As String
    Dim rsCommodity As New ADODB.Recordset
    Dim i As Integer
    Dim strCommodityID As String

    strQuery = "SELECT * FROM IntlCommodities WHERE f1 = '" & g_str1 & "'"
    strQuery = strQuery & " AND Workstation = '" & g_strComputerName & "'"
    strQuery = strQuery & " AND (g_str29 IS NULL OR g_str29 = '')"
    rsCommodity.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic

    Do While Not rsCommodity.EOF

        If Trim(rsCommodity!g_str1275) & "" <> "" Then
            strCommodityID = Trim(rsCommodity!g_str1275 & "")
        ElseIf Trim(rsCommodity!g_str120) & "" <> "" Then
            strCommodityID = Trim(rsCommodity!g_str120 & "")
        Else
            strCommodityID = ""
        End If

        If strCommodityID <> "" Then
            'Build query
            strQuery = "UPDATE Commodity SET "
            strQuery = strQuery + "CommodityWgt = " & SingleQuotes(rsCommodity!g_str77) & "" & ", "
            strQuery = strQuery + "g_str79 = " & SingleQuotes(rsCommodity!g_str79) & "" & ", "
            strQuery = strQuery + "g_str80 = " & SingleQuotes(rsCommodity!g_str80) & "" & ", "
            strQuery = strQuery + "g_str81 = " & SingleQuotes(rsCommodity!g_str81) & "" & ", "
            strQuery = strQuery + "g_str83 = " & SingleQuotes(rsCommodity!g_str83) & "" & ", "
            strQuery = strQuery + "g_str84 = " & SingleQuotes(rsCommodity!g_str84) & "" & ", "
            strQuery = strQuery + "g_str414 = " & SingleQuotes(rsCommodity!g_str414) & "" & ", "
            strQuery = strQuery + "g_str1030 = " & SingleQuotes(rsCommodity!g_str1030) & "" & ", "
            strQuery = strQuery + "g_str120 = " & SingleQuotes(rsCommodity!g_str120) & "" & ", "
            strQuery = strQuery + "g_str1275 = " & SingleQuotes(rsCommodity!g_str1275) & "" & " "
            strQuery = strQuery + "WHERE CommodityID = " & SingleQuotes(strCommodityID) & ""

            g_connFSMSClient.Execute strQuery, i
            Call PauseMicro(10)
            If i <= 0 Then
                'Build query
                strQuery = "INSERT INTO Commodity VALUES ("
                strQuery = strQuery + Replace(SingleQuotes(strCommodityID), Chr(34), "") + ","  'CommodityID
                strQuery = strQuery + Replace(SingleQuotes(rsCommodity!g_str77), Chr(34), "") + ","  'CommodityWgt
                strQuery = strQuery + Replace(SingleQuotes(rsCommodity!g_str79), Chr(34), "") + ","  'g_str79 - Description
                strQuery = strQuery + Replace(SingleQuotes(rsCommodity!g_str80), Chr(34), "") + ","  'g_str80 - Country of Manu
                strQuery = strQuery + Replace(SingleQuotes(rsCommodity!g_str81), Chr(34), "") + ","  'g_str81 - Harmonized Code
                strQuery = strQuery + Replace(SingleQuotes(rsCommodity!g_str83), Chr(34), "") + ","  'g_str83 - Export License #
                strQuery = strQuery + Replace(SingleQuotes(rsCommodity!g_str84), Chr(34), "") + ","  'g_str84 - License Expiration Date
                strQuery = strQuery + Replace(SingleQuotes(rsCommodity!g_str414), Chr(34), "") + ","  'g_str414 - Unit of Measure
                strQuery = strQuery + Replace(SingleQuotes(rsCommodity!g_str1030), Chr(34), "") + ","  'g_str1030 - Commodity Unit Value
                strQuery = strQuery + Replace(SingleQuotes(rsCommodity!g_str120), Chr(34), "") + ","  'g_str120
                strQuery = strQuery + Replace(SingleQuotes(rsCommodity!g_str1275), Chr(34), "") + ")"  'g_str1275

                'Execute the query
                On Error Resume Next
                g_connFSMSClient.Execute strQuery, i
                Call PauseMicro(10)
            End If
        End If

        rsCommodity.MoveNext
    Loop

Release:
    Exit Sub

Handler:
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.WriteReply"
    Call Kill
    Resume Release

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteError()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an FXRS Error reply transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteError()
    MsgBox "Shipping Error: " & g_str3, vbCritical, "FSMS Error"
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteDelete()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             successful FXRS Delete.
'---------------------------------------------------------------------------------------
'
Public Sub WriteDelete(ByVal strTracking As String)
'Called:    frmShip Parsecomplete event on FSMS 123 reply
'Purpose:   update customer table on void
    On Local Error GoTo Handler

    WriteDeleteText EXPORT_FILE_PATH, strTracking

Release:
   ' call kill
   Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.WriteDelete"
    Call Kill
    Resume Release

End Sub
'



Public Function WriteDeleteText(ByVal strInputFileName As String, ByVal strDeleteValue As String) As Boolean
'**********************************************************************************
' Delete a record from a file by string value
' Inputs:  strInputFileName (textfile) including path,
'          strDeleteValue, string value for search
' Opens two files:  Original and temp.  Reads original file and writes all records
' except record(s) containing search value to the temp file, then copies the temp
' file to the original.
'
' Author:   Krishna Ravinuthala
' Date:     07/29/2003
'**********************************************************************************

    Dim strOne_Line As String
    Dim intDeleted As Integer
    Dim objFS As Object
    Dim objInputFile As Object
    Dim objOutputFile As Object
    Dim strOutputFilename As String

    On Error GoTo Err_Handler

    Set objFS = CreateObject("Scripting.FileSystemObject")

    'Check for existance of file
    If objFS.FileExists(strInputFileName) Then

        'Open the input file
        Set objInputFile = objFS.OpenTextFile(strInputFileName)
        'Open the output file
        strOutputFilename = Left(strInputFileName, Len(strInputFileName) - 4) & "Temp" & Right(strInputFileName, 4)

        If objFS.FileExists(strOutputFilename) Then
            objFS.DeleteFile (strOutputFilename)
            Set objOutputFile = objFS.CreateTextFile(strOutputFilename)
        Else
            Set objOutputFile = objFS.CreateTextFile(strOutputFilename)
        End If

        intDeleted = 0

        'Copy the file skipping lines containing the strDeleteValue
        Do While objInputFile.AtEndOfLine <> True
            strOne_Line = objInputFile.ReadLine
            If InStr(1, strOne_Line, ",""" & strDeleteValue & """,") = 0 Then
                objOutputFile.WriteLine (strOne_Line)
            Else
                intDeleted = intDeleted + 1
            End If
        Loop
        objOutputFile.Close
        objInputFile.Close
        Set objOutputFile = Nothing
        Set objInputFile = Nothing
        'Copy corrected output file to original input file
        objFS.CopyFile strOutputFilename, strInputFileName, True
        'Delete corrected output file (TEMPFILE)
        objFS.DeleteFile (strOutputFilename)
        Set objFS = Nothing

    Else
        'Input File Does Not Exist, do nothing
    End If

    Exit Function

Err_Handler:
    Set objOutputFile = Nothing
    Set objInputFile = Nothing
    Set objFS = Nothing

    MsgBox ("Delete Record error: " & Err.Description), vbSystemModal, "Delete Record Module"

End Function



'**********************************************************************************
' Delete a record from a file by string value
' Inputs:  strInputFileName (textfile) including path,
'          strDeleteValue, string value for search
' Opens two files:  Original and temp.  Reads original file and writes all records
' except record(s) containing search value to the temp file, then copies the temp
' file to the original.
'
' Author:   Krishna Ravinuthala
' Date:     07/29/2003
'**********************************************************************************
Private Function DeleteTextRecord(ByVal strInputFileName As String, ByVal strDeleteValue As String) As Boolean

Dim strOne_Line As String
Dim intDeleted As Integer
Dim objFS As Object
Dim objInputFile As Object
Dim objOutputFile As Object
Dim strOutputFilename As String

On Error GoTo Err_Handler

Set objFS = CreateObject("Scripting.FileSystemObject")

'Check for existance of file
If objFS.FileExists(strInputFileName) Then

    'Open the input file
    Set objInputFile = objFS.OpenTextFile(strInputFileName)
    'Open the output file
    strOutputFilename = Left(strInputFileName, Len(strInputFileName) - 4) & "Temp" & Right(strInputFileName, 4)

    If objFS.FileExists(strOutputFilename) Then
        objFS.DeleteFile (strOutputFilename)
        Set objOutputFile = objFS.CreateTextFile(strOutputFilename)
    Else
        Set objOutputFile = objFS.CreateTextFile(strOutputFilename)
    End If

    intDeleted = 0
    'Copy the file skipping lines containing the strDeleteValue
    Do While objInputFile.AtEndOfLine <> True
        strOne_Line = objInputFile.ReadLine
        If InStr(strOne_Line, strDeleteValue) = 0 Then
            objOutputFile.WriteLine (strOne_Line)
        Else
            intDeleted = intDeleted + 1
        End If
    Loop
    objOutputFile.Close
    objInputFile.Close
    Set objOutputFile = Nothing
    Set objInputFile = Nothing
    'Copy corrected output file to original input file
    objFS.CopyFile strOutputFilename, strInputFileName, True
    'Delete corrected output file (TEMPFILE)
    objFS.DeleteFile (strOutputFilename)
    Set objFS = Nothing

    'MsgBox intDeleted & " Record(s) deleted from:  " & strInputFileName, vbSystemModal, "Delete Record Module"
Else
    'MsgBox "Input File " & strInputFileName & " Does Not Exist!!!", vbSystemModal, "Delete Record Module"
End If

Exit Function

Err_Handler:
    Set objOutputFile = Nothing
    Set objInputFile = Nothing
    Set objFS = Nothing

    MsgBox ("Delete Record error: " & Err.Description), vbSystemModal, "Delete Record Module"

End Function






'---------------------------------------------------------------------------------------
' Procedure : Connect()
' DateTime  : 7/5/2004
' Purpose   : Open connection to ODBC test DSN. Instantiate module level recordset.
'---------------------------------------------------------------------------------------
'
Private Function Connect() As Boolean
    On Local Error GoTo Handler
    Dim strDSN As String
    Dim boolSecondTry As Boolean

    If m_CNInText Is Nothing Then
        Set m_CNInText = New ADODB.Connection
    End If
    If m_CNInDB Is Nothing Then
        Set m_CNInDB = New ADODB.Connection
    End If
    Set m_RS = New ADODB.Recordset

    If m_CNInDB.State <> adStateOpen Then   'if connection is not open then do so
        If GetSystemName = "WINXPC9CA96EA3" Then
            Call AddDSN
            m_CNInDB.Open "DSN=FedExMedtronic"
        Else
            m_CNInDB.Open "DSN=FDXDB"
        End If
    End If

    Connect = True

    Exit Function

Handler:
    If Not boolSecondTry Then
        boolSecondTry = True
        If Err.number = -2147467259 Then
            Call AddDSN
            Resume
        End If
    End If
    MsgBox Err.Description, , "modODBC.Connect"
    Call Kill        'kill connection and recordset

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : Kill()
' DateTime  : 7/5/2004
' Purpose   : Close connection and recordset objects and set = to nothing.
'---------------------------------------------------------------------------------------
'
Public Sub Kill()
    On Local Error GoTo Handler

    If Not m_RS Is Nothing Then
        If m_RS.State = adStateOpen Then m_RS.Close
    End If
    If Not m_CNInDB Is Nothing Then
        If m_CNInDB.State = adStateOpen Then m_CNInDB.Close
    End If

    Set m_CNInDB = Nothing      'kill connection
    Set m_RS = Nothing      'kill recordset

    If Not m_CNOut Is Nothing Then
        If m_CNOut.State = adStateOpen Then m_CNOut.Close
    End If

    Set m_CNOut = Nothing      'kill connection

    Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.Kill"

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterAddrVerify()
' DateTime  : 5/12/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             Address Verification. Three possible status codes are passed. See comments
'             below.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerify(ByVal intStatusCode As Integer)

    Select Case intStatusCode
        'Address is verfified
        Case 1

        'Soft error
        Case 2

        'Hard error
        Case 3

    End Select

End Sub

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrVerifyUpdate()
' DateTime  : 9/13/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an address has been updated on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerifyUpdate()

End Sub


'---------------------------------------------------------------------------------------
' Procedure : AfterBatchShip()
' DateTime  : 10/28/2005
' Purpose   : REQUIRED SUB. Called just after a batch transaction has been processed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatchShip()

End Sub
'---------------------------------------------------------------------------------------
' Procedure : AfterBatch()
' DateTime  : 4/6/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a batch shipment has been completed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatch()

End Sub


'---------------------------------------------------------------------------------------
' Procedure : AfterClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Sub AfterClose()

End Sub
'

' 2007-04-13, JFW, Allow for custom screen display.
Public Sub AfterConnect()

    ' For Manulife, go to customer lookup
    ' Call frmShip.ToggleLookup(True)

End Sub
'

' 2007-04-13, JFW, Allow for custom screen display.
Public Sub AfterDisconnect()

    On Error Resume Next
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterLoadServices()
' DateTime  : 5/17/2011
' Purpose   : Remove or add custom services.
' 2011-05-17, JFW, New for Scapa
'---------------------------------------------------------------------------------------
'
Public Sub AfterLoadServices(c1 As ComboBox)

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterLocationChange()
' DateTime  : 3/06/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             the shipping Location has been changed on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLocationChange()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterLostFocus()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboDept or f38 loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLostFocus(c1 As Control)

    If c1.name = "f38" Then
        'g_clsReg.SetRegistryValue "Carry_f38", frmShip.f38, REG_SZ
    End If
    If c1.name = "f1273" Then
        'g_clsReg.SetRegistryValue "Carry_f1273", Left(frmShip.f1273.Text, 2), REG_SZ
    End If
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterRateQuote()
' DateTime  : 20071106-01
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a rate quote.
'---------------------------------------------------------------------------------------
'
Public Sub AfterRateQuote()

End Sub

' 2012-01-19, JFW, New for UCS.
Public Function AfterScreenChange(f As Form) As Boolean

End Function

'---------------------------------------------------------------------------------------
' Procedure : BeforeClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed before
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Function BeforeClose() As Boolean

    BeforeClose = True

End Function
'

' 2012-01-19, JFW, New for UCS.
Public Function BeforeGotFocus(f As Form, c As Control) As Boolean
    On Error GoTo Test
    Exit Function
Test:
    DebugPrint "BeforeGotFocus, " & Err.Description
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : BeforeShip()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShip(Optional TransString As String = "") As Boolean

    With frmShip
        If .f38.Text <> "" Then
            If .f3056.Text = "" Then
                .f3056.Text = .f38.Text
                g_str3056 = .f3056.Text                                       'Pkg P.O. #
            End If
            If .f3057.Text = "" Then
                .f3057.Text = .f38.Text
                g_str3057 = .f3057.Text                                       'Pkg Invoice #
            End If
            BeforeShip = True
        Else
            frmMsgBox.ShowMessage "Please choose a Department; this is a required field.", 2000
            BeforeShip = False
        End If
    End With


End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeShipTrans()
' DateTime  : 8/7/2008
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShipTrans(ByRef TransString As String) As Boolean
    
    Dim lngMsgBoxResult As VbMsgBoxResult
    BeforeShipTrans = True
    
End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BuildCustomSPLabel()
' DateTime  : 20070620-04
' Purpose   : REQUIRED SUB. Can be used as hook to create custom EPL or ZPL buffer labels
'             for SmartPost.
'---------------------------------------------------------------------------------------
'
Public Function BuildCustomSPLabel(ByVal strLabel As String) As String

    BuildCustomSPLabel = strLabel

End Function


Public Sub EditBoxLostFocus(objControl As Control)

End Sub


'---------------------------------------------------------------------------------------
' Procedure : Initialize()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution.
'---------------------------------------------------------------------------------------
'
Public Sub Initialize(Optional f1 As Form)

    NASCAR_VERSION = "FSMSClient v800.2.1"

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeBatch()
' DateTime  : 8/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution. Called before an entire batch is processed.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatch() As Boolean

    BeforeBatch = True

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeBatchShip()
' DateTime  : 8/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution. Called just before a batch transaction is sent to the server.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatchShip() As Boolean

    BeforeBatchShip = True

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrLookup()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboCustID, cboContact, or cboCompany loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrLookup()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterDeptLostFocus()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboDept or f38 loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterDeptLostFocus()

    frmShip.f3056.Text = frmShip.f38.Text
    frmShip.f3057.Text = frmShip.f38.Text

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : GetPickupData()
' DateTime  : 1/30/2006
' Purpose   : REQUIRED SUB. Called from frmAddTags.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetPickupData(ByVal strKey As String) As Boolean

    GetPickupData = True

End Function

' 2011-05-05, JFW, For Scapa
Public Function TDAutoCloseEnabled() As Boolean
    TDAutoCloseEnabled = False
End Function
'

'---------------------------------------------------------------------------------------
' Procedure : WriteBatchEditReply()
' DateTime  : 1/17/2006
' Purpose   : REQUIRED SUB. Called after a successful Batch Error Edit transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBatchEditReply()

End Sub
' Procedure : WriteTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteTagReply()

End Sub
' Procedure : WriteCancelTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Cancel Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteCancelTagReply()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteReturnDelete()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label delete transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnDelete(ByVal strTracking As String)

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteReturnReply()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnReply()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteBOLReply()
' DateTime  : 1/11/2006
' Purpose   : REQUIRED SUB. Called after a successful FedEx Freight BOL transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBOLReply()

End Sub



' Remove apostrophe from string for SQL text commands
'
Public Function AposTrim(aString As String) As Variant

    On Error GoTo EH
    AposTrim = Trim(Replace(aString, "'", "`"))
    Exit Function

EH:
    AposTrim = Null

End Function


'---------------------------------------------------------------------------------------
' ZipToProvince
' Get province code from zip code.
'---------------------------------------------------------------------------------------
Public Function ZipToProvince(ByVal strZipCode As String) As String

    strZipCode = UCase(strZipCode)

    If Not IsNumeric(strZipCode) Then
        Select Case Left(strZipCode, 1)
        Case "A"
            ZipToProvince = "NL"
        Case "B"
            ZipToProvince = "NS"
        Case "C"
            ZipToProvince = "PE"
        Case "E"
            ZipToProvince = "NB"
        Case "G", "H", "J"
            ZipToProvince = "QC"
        Case "K", "L", "M", "N", "P"
            ZipToProvince = "ON"
        Case "R"
            ZipToProvince = "MB"
        Case "S"
            ZipToProvince = "SK"
        Case "T"
            ZipToProvince = "AB"
        Case "V"
            ZipToProvince = "BC"
        Case "X"
            ZipToProvince = "NT"
        Case "Y"
            ZipToProvince = "YK"
        End Select
    End If

End Function
'
#End If

